home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / gen_vid / anscrt.com / ANSCRT.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-03-28  |  12.5 KB  |  335 lines
  1.   Unit AnsCrt;
  2.   {By Rick Housh - CIS PIN 72466,212}
  3.   {ANSI Alternate to CRT unit}
  4.   {Uses standard ANSI calls for all cursor placement, color attribute }
  5.   {changes, etc., and Interrupt 21h DOS calls for everything else. }
  6.   {No ROM BIOS calls at all.  Should work on any MS-DOS computer with ANSI}
  7.   {support.}
  8.   {
  9.     Revisions for version 2.00 - 3/28/89.  Rewritten for TP version 5.00
  10.     Now works with PC Magazine ANSI.COM
  11.     Minor revisions to keyboard routines
  12.   }
  13. (**************************************************************************)
  14. { The variable TextAttr is maintained, although not used.  Just for the
  15.   curious.  It serves no purpose.  The variable CheckBreak is supported.
  16.   None of the other variables are supported, as almost all have to do
  17.   with various aspects of direct screen writing, which is not supported.
  18.  
  19.   None of the Crt Mode constants are supplied.  All of the Text Color
  20.   constants are supported.
  21.  
  22.   It is possible to do much more with ANSI actually, than with many of
  23.   Turbo's standard CRT procedures, but no extras were implemented, in
  24.   the interest of compatibility with Turbo.
  25.  
  26.   There is one major limitation.  The window procedure is not supported.
  27.   In the interest of universal compatibility Textmode is also not supported,
  28.   although it could be.
  29.  
  30.   The following CRT unit functions and procedures are supported as follows:
  31.     AssignCrt      :   Not supported
  32.     ClrEol         :   Fully supported
  33.     ClrScr         :   Fully supported
  34.     Delay          :   Not supported
  35.     DelLine        :   Not supported    (Could easily be, but never used it)
  36.     GotoXY         :   Fully supported
  37.     HighVideo      :   Fully supported
  38.     InsLine        :   Not Supported    (See DelLine)
  39.     LowVideo       :   Fully supported
  40.     NoSound        :   Not supported
  41.     Sound          :   Not supported
  42.     TextBackground :   Fully supported
  43.     TextColor      :   Fully supported
  44.     TextMode       :   Not supported
  45.     Window         :   Not supported
  46.     KeyPressed     :   Fully supported
  47.     NormVideo      :   Fully supported
  48.     ReadKey        :   Fully supported
  49.     WhereX         :   Fully supported
  50.     WhereY         :   Fully supported
  51.  
  52.   Those miscellaneous functions which are not supported are almost all
  53.   available in Carley Phillip's CRTI unit, available in this DL as
  54.   CRTI.ARC.  Combine some of these and some of those in one unit if you
  55.   need the Sound, NoSound, Delay, etc.  If you do this however, you will
  56.   lose some of the MS-DOS generic nature of these routines, which depend
  57.   only on DOS and ANSI, and require no IBM compatibility.  Under NO
  58.   circumstances may this unit be used in combination with the standard
  59.   CRT unit.  It is a replacement.  The Graph, Graph3 and Turbo3 units
  60.   are not compatible with this unit and should not be used either.
  61.  
  62.  This unit supplies one unit not available in CRT, the GetKey function.
  63.  Most of the time I just want a character returned.  I am not interested
  64.  in function keys, etc.  GetKey does just that.  It first flushes the
  65.  keyboard, in case you accidentally pressed something, ignores function
  66.  keys, and returns the value of the keypress as a character.  Where the
  67.  variable ch is a character, the appropriate syntax would be:
  68.     ch := GetKey;
  69.  It will then wait for the key.
  70.  
  71.         This program is dedicated to the public domain.
  72.         No copyright is claimed.
  73.         I would be interested in reports.
  74.                     Rick Housh
  75.                     5811 W. 85th Terr.
  76.                     Overland Park, KS 66207
  77.                     Tel. 913/341-7592
  78.                     Compuserve PIN #72466,212
  79.  
  80. }
  81.  
  82.  
  83.  
  84.  
  85.   Interface
  86.   Const
  87.     Black = 0; Blue = 1; Green = 2; Cyan = 3; Red = 4; Magenta = 5;
  88.     Brown = 6; LightGray = 7; DarkGray = 8; LightBlue = 9;
  89.     LightGreen = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13;
  90.     Yellow = 14; White = 15; Blink = 128;
  91.  
  92.   Var
  93.     CheckBreak, CheckEOF,
  94.      Blinking            : Boolean;
  95.     TextAttr, ForeColour,
  96.      BackColour          : Byte;
  97.     Function Keypressed  : Boolean;
  98.     Function GetKey      : Char;
  99.     Function ReadKey     : Char;
  100.     Function WhereX      : Byte;
  101.     Function WhereY      : Byte;
  102.     Procedure NormVideo;
  103.     Procedure LowVideo;
  104.     Procedure HighVideo;
  105.     Procedure ClrEol;
  106.     Procedure ClrScr;
  107.     Procedure GotoXY(X, Y : Byte);
  108.     Procedure TextBackGround(Back : Byte);
  109.     Procedure TextColor(Fore : Byte);
  110.  
  111.  
  112.   Implementation
  113.  
  114.   Function KeyPressed : boolean;   { Replacement for CRT.KeyPressed }
  115.                          {  ;Detects whether a key is pressed}
  116.                          {  ;Does nothing with the key}
  117.                          {  ;Returns true if key is pressed}
  118.                          {  ;Otherwise, false}
  119.                          {  ;Key remains in kbd buffer}
  120.     Var IsThere : Byte;
  121.     Begin
  122.       Inline(
  123.       $B4/$0B/               {    MOV AH,+$0B         ;Get input status}
  124.       $CD/$21/               {    INT $21             ;Call DOS}
  125.       $88/$86/>ISTHERE);     {    MOV >IsThere[BP],AL ;Move into variable}
  126.       If IsThere = $FF then Keypressed := True else keypressed := False;
  127.     end;
  128.  
  129.   Procedure  ClrEol;     { ANSI replacement for CRT.ClrEol }
  130.     Begin
  131.       Write(#27'[K');
  132.     end;
  133.  
  134.   Procedure ClrScr;     { ANSI replacement for CRT.ClrScr }
  135.     Begin
  136.       Write(#27'[2J');
  137.     end;
  138.  
  139. Function GetKey : Char;
  140. var CHRX : CHAR;
  141. Begin
  142. Inline(
  143.   $B4/$06/               {X0:   MOV     AH,+$06         ;First clear       }
  144.   $B2/$FF/               {      MOV     DL,-$01         ;Keyboard buffer   }
  145.   $CD/$21/               {      INT     $21                                }
  146.   $75/$F8/               {      JNZ     X0              ;Repeat until done }
  147.   $B4/$07/               {X8:   MOV     AH,+$07         ;Now get a key     }
  148.   $CD/$21/               {      INT     $21                                }
  149.   $08/$C0/               {      OR      AL,AL           ;If 0, then special}
  150.   $74/$F8/               {      JZ      X8              ;so get another    }
  151.   $88/$86/>CHRX);        {      MOV     [BP+>CHRX],AL   ;Put in variable   }
  152.   If CheckBreak and (CHRX = #3) then
  153.     Begin                {If CheckBreak is true and it's a ^C}
  154.       Inline(            {then execute Ctrl_Brk}
  155.       $CD/$23);
  156.     end;
  157.   GetKey := CHRX;        {                              ; and in GetKey    }
  158. end; {Function GetKey}
  159.  
  160.  
  161.   Function ReadKey : char;  { Replacement for CRT.ReadKey }
  162.     Var chrout : char;
  163.     Begin
  164.                          {  ;Just like ReadKey in CRT unit}
  165.       Inline(
  166.       $B4/$07/               {  MOV AH,$07          ;Char input w/o echo}
  167.       $CD/$21/               {  INT $21             ;Call DOS}
  168.       $88/$86/>CHROUT);      {  MOV >chrout[bp],AL  ;Put into variable}
  169.       If CheckBreak and (chrout = #3) then  {If it's a ^C and CheckBreak true}
  170.         Begin                             {then execute Ctrl_Brk}
  171.           Inline(
  172.           $CD/$23);           {     INT $23}
  173.         end;
  174.       ReadKey := chrout;                    {else return character}
  175.     end;
  176.  
  177.  
  178.   Function WhereX : byte;       { ANSI replacement for CRT.WhereX }
  179.     var                         { Cursor position report. This is column or }
  180.       ch  : char;               { X axis report.}
  181.       st  : String;
  182.       st1 : String[2];
  183.       x   : byte;
  184.       i   : integer;
  185.  
  186.     begin
  187.       Write(#27'[6n');          { Ansi string to get X-Y position }
  188.       st := '';                 { We will only use X here }
  189.       ch := #0;                 { Make sure character is not 'R' }
  190.       While ch <> 'R' do        { Return will be }
  191.         begin                   { Esc - [ - Ypos - ; - Xpos - R }
  192.           ch := #0;
  193.           ch := readkey;        { Get one }
  194.           st := st + ch;        { Build string }
  195.         end;
  196.         i := Pos(';',St) + 1;
  197.         x := Length(St) - i;
  198.         St1 := copy(St,i,x);    { Pick off substring having number in ASCII}
  199.         Val(St1,x,i);           { Make it numeric }
  200.         WhereX := x;            { Return the number }
  201.     end;
  202.  
  203.   Function WhereY : byte;       { ANSI replacement for CRT.WhereY }
  204.     var                         { Cursor position report.  This is row or }
  205.       ch  : char;               { Y axis report.}
  206.       st  : String;
  207.       st1 : String[2];
  208.       y   : byte;
  209.       i   : integer;
  210.  
  211.     begin
  212.       Write(#27'[6n');          { Ansi string to get X-Y position }
  213.       st := '';                 { We will only use Y here }
  214.       ch := #0;                 { Make sure character is not 'R' }
  215.       While ch <> 'R' do        { Return will be }
  216.         begin                   { Esc - [ - Ypos - ; - Xpos - R }
  217.           ch := #0;
  218.           ch := readkey;        { Get one }
  219.           st := st + ch;        { Build string }
  220.         end;
  221.         i := Pos(';',St) - 3;
  222.         St1 := copy(St,3,i);    { Pick off substring having number in ASCII}
  223.         Val(St1,y,i);           { Make it numeric }
  224.         WhereY := y;            { Return the number }
  225.     end;
  226.  
  227.  
  228.     Procedure GotoXY(x : byte ; y : byte); { ANSI replacement for CRT.GoToXY}
  229.       Begin
  230.         If (x < 1) or (y < 1) then exit;
  231.         If (x > 80) or (y > 25) then exit;
  232.         Write(#27'[',y,';',x,'H');
  233.       end;
  234.  
  235.    Procedure TextColor(Fore : Byte);
  236.      Begin
  237.        If not ((Fore in [0..15]) or (Fore in [128..143])) then exit;
  238.        ForeColour := Fore;
  239.        Blinking := False;
  240.        Write(#27'[0m');
  241.        TextBackGround(BackColour);
  242.        If Fore >  127 then
  243.          begin
  244.            If Fore > 128 then Fore := Fore - 128;
  245.            Blinking := True;
  246.            Write(#27'[5m');
  247.          end;
  248.        Case Fore of
  249.           0  :  Write(#27'[30m');
  250.           1  :  Write(#27'[34m');
  251.           2  :  Write(#27'[32m');
  252.           3  :  Write(#27'[36m');
  253.           4  :  Write(#27'[31m');
  254.           5  :  Write(#27'[35m');
  255.           6  :  Write(#27'[33m');
  256.           7  :  Write(#27'[37m');
  257.           8  :  Write(#27'[1;30m');
  258.           9  :  Write(#27'[1;34m');
  259.          10  :  Write(#27'[1;32m');
  260.          11  :  Write(#27'[1;36m');
  261.          12  :  Write(#27'[1;31m');
  262.          13  :  Write(#27'[1;35m');
  263.          14  :  Write(#27'[1;33m');
  264.          15  :  Write(#27'[1;37m');
  265.        end;  { Case }
  266.  
  267.        TextAttr := (TextAttr AND $70) + Fore;
  268.      end;
  269.  
  270.    Procedure TextBackGround(Back : Byte);{Replacement for CRT.TextBackground}
  271.      Begin
  272.        If Back > 7 then exit;     { No illegal values allowed }
  273.        BackColour := Back;
  274.        Case Back of
  275.            0  :  Write(#27'[40m');
  276.            1  :  Write(#27'[44m');
  277.            2  :  Write(#27'[42m');
  278.            3  :  Write(#27'[46m');
  279.            4  :  Write(#27'[41m');
  280.            5  :  Write(#27'[45m');
  281.            6  :  Write(#27'[43m');
  282.            7  :  Write(#27'[47m');
  283.          end;  { Case }
  284.        TextAttr := (TextAttr AND $8F) + Back * 16;
  285.      end;
  286.  
  287.  
  288.    Procedure NormVideo;   { ANSI Replacement for CRT.NormVideo }
  289.      Begin
  290.        Write(#27'[0m');
  291.        ForeColour := LightGray;
  292.        BackColour := Black;
  293.        TextAttr := $07;   { Just to maintain it }
  294.      end;
  295.  
  296.    Procedure LowVideo;    { Replacement for CRT.LowVideo }
  297.      Begin
  298.        If ForeColour > 7 then ForeColour := ForeColour - 8;
  299.        Write(#27'[0m');
  300.        TextBackGround(BackColour);
  301.        If not Blinking then TextColor(ForeColour)
  302.           else TextColor(ForeColour + 128);
  303.        TextAttr := TextAttr AND $0F;  {Just to maintain it}
  304.      end;
  305.  
  306.    Procedure HighVideo;   { Replacement for CRT.HighVideo }
  307.      Begin
  308.        If ForeColour < 8 then ForeColour := ForeColour + 8;
  309.        If Not Blinking then TextColor(ForeColour)
  310.            else TextColor(ForeColour + 128);
  311.        TextAttr := TextAttr OR $0F;
  312.      end;
  313.  
  314.  
  315.    var Dummy : char;        {Local variable to eat characters}
  316.  
  317.    Begin    { Setup }
  318.     CheckBreak := True;
  319.     CheckEOF := False;
  320.     TextAttr := 7;
  321.     BackColour := Black;
  322.     ForeColour := LightGray;
  323.     Blinking   := False;
  324.     Write(#27'[6n');               { Ask for cursor position report via }
  325.       If not keypressed then       { the ANSI driver.  If it returns }
  326.           begin                    { nothing in the keyboard buffer }
  327.             WriteLn(               { then no ANSI, so abort }
  328.  #13#7'This program requires the ANSI driver and it is not loaded.  Aborting.');
  329.             Halt;
  330.           end
  331.             else                   { If ANSI is loaded then }
  332.           Repeat                   { just empty the keyboard buffer }
  333.             Dummy := Readkey;
  334.           until not keypressed;
  335.    end.